home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / oldwp / Prefs / IDCMP.PAS next >
Pascal/Delphi Source File  |  1995-02-25  |  10KB  |  383 lines
  1. Procedure InfoGadFunc;
  2.  
  3. VAR
  4.     ret : LONG;
  5.     al  : Array[0..2] of LONG;
  6.     grk : pRemember;
  7.     ez  : pEasyStruct;
  8.     
  9. begin
  10.     grk := NIL;
  11.     wl := Pointer(rtLockWindow(TheWindow));
  12.     
  13.     ez := AllocRemember(@grk, Sizeof(tEasyStruct), MEMF_CLEAR);
  14.     if ez <> NIL then begin
  15.         With ez^ do begin
  16.             es_StructSize :=  Sizeof(tEasyStruct);
  17.             es_Title := CStrConstPtrAR(@grk, 'WangiPad Prferences');
  18.             es_TextFormat := CStrConstPtrAR(@grk,
  19.                             'WangiPad Copyright ©Lee Kindness.'#10+
  20.                             '%s'#10#10+
  21.                             'A compact launch-pad utility'#10+
  22.                             'Read "WangiPad.Guide" for more information'#10#10+
  23.                             'Comments to:'#10+
  24.                             ' Lee Kindness'#10+
  25.                             ' 8 Craigmarn Road'#10+
  26.                             ' Portlethen Village'#10+
  27.                             ' Aberdeen AB1 4QR'#10+
  28.                             ' SCOTLAND'#10#10+
  29.                             'Registered to: %s'#10+
  30.                             'ID: %lx');
  31.             es_GadgetFormat := CStrConstPtrAR(@grk, 'Ok');
  32.         End;
  33.         al[0] := LONG(@Prefsver[6]);
  34.         al[1] := LONG(CStrConstPtrAR(@grk, Reg.key_User));
  35.         al[2] := Reg.key_ID;
  36.         ret := EasyRequestArgs(TheWindow, ez, NIL, @al);
  37.     end;
  38.     FreeRemember(@grk, True);
  39.     rtUnLockWindow(TheWindow, wl);
  40. end;
  41.  
  42. { Use Reqtools requesters to get screen/window title strings from the user }
  43. Procedure GetTitles;
  44.  
  45. VAR
  46.     buffer: String[128];
  47.     ret   : Long;
  48.     tags  : array [0..4] of tTagItem;
  49.  
  50. begin
  51.     wl := Pointer(rtLockWindow(TheWindow));
  52.     tags[0].ti_Tag  := RT_Window;
  53.     tags[0].ti_Data := LONG(TheWindow);
  54.     tags[1].ti_Tag  := RTGS_TextFmt;
  55.     tags[1].ti_Data := LONG(CStrConstPtrAR(@RememberKey, 'Enter the text to be displayed'+#10+' on the screen titlebar.'));
  56.     tags[2].ti_Tag  := RTGS_FLAGS;
  57.     tags[2].ti_Data := GSREQF_CENTERTEXT;
  58.     tags[3].ti_Tag  := RTGS_AllowEmpty;
  59.     tags[3].ti_Data := True_;
  60.     tags[4].ti_Tag  := TAG_END;
  61.  
  62.     buffer := PtrToPas(CD.cd_ScrTit)+#0;
  63.     If GetWindow then begin
  64.         ret := rtGetStringA (@buffer[1], 127, CStrConstPtrAR(@RememberKey, Win_Title), NIL, @tags);
  65.         if ret <> 0 then
  66.             CD.cd_ScrTit := CStrConstPtrAR(@RememberKey, PtrToPas(@Buffer[1]));
  67.     End else begin
  68.         buffer := PtrToPas(CD.cd_WinTit)+#0;
  69.         tags[1].ti_Data := LONG(CStrConstPtrAR(@RememberKey, 'Enter the text to be displayed'+#10+' on the window titlebar.'));
  70.         ret:=rtGetStringA (@buffer[1], 127, CStrConstPtrAR(@RememberKey, Win_Title), NIL, @tags);
  71.         if ret <> 0 then 
  72.             CD.cd_WinTit := CStrConstPtrAR(@RememberKey, PtrToPas(@buffer[1]));
  73.     End;
  74.     rtUnLockWindow(TheWindow, wl);
  75. end;
  76.  
  77.  
  78.  
  79. { move a node up to the of the list }
  80. Procedure TopGadFunc;
  81.  
  82. begin
  83.     if currentnode <> NIL then begin
  84.         DetachObjectList;
  85.         Remove(pNode(CurrentNode));
  86.         AddHead(CurrentList,pNode(CurrentNode));
  87.         CurrentOrd := 0; 
  88.         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  89.         currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  90.         else currenttop := 0;
  91.         AttachObjectList;
  92.     end;
  93. end;
  94.  
  95. { move a node up the list }
  96. Procedure UpGadFunc;
  97.  
  98. begin
  99.     pred := pMyNode(Currentnode^.wi_Node.ln_Pred);
  100.     if (CurrentNode <> NIL) and (pred <> NIL) then begin
  101.         DetachObjectList;
  102.         (* Move node one position up *)
  103.         pred := pMyNode(pred^.wi_Node.ln_Pred);
  104.         Remove(pNode(CurrentNode));
  105.         Insert_(CurrentList,pNode(CurrentNode),pNode(pred));
  106.         CurrentOrd := CurrentOrd - 1;
  107.         if currentord < 0 then currentord := 0;
  108.         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  109.             currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  110.         else 
  111.             currenttop := 0;
  112.         AttachObjectList;
  113.     end;
  114. end;
  115.  
  116. { move a node down the list }
  117. Procedure DownGadFunc;
  118.  
  119. begin
  120.     succ := pMyNode(currentnode^.wi_Node.ln_Succ);
  121.     if (CurrentNode <> NIL) and (succ <> NIL) then begin
  122.         DetachObjectList;
  123.         Remove(pNode(CurrentNode));
  124.         Insert_(CurrentList,pNode(CurrentNode),pNode(succ));
  125.         Currentord := currentord + 1;
  126.         i := 0;
  127.         tmpnode := pMyNode(currentlist^.lh_Head);
  128.         While tmpnode <> NIL do begin
  129.             i := i + 1;
  130.             tmpnode := pMyNode(tmpnode^.wi_Node.ln_Succ);
  131.         end;
  132.         i := i-2;
  133.         if currentord > i then currentord := i;
  134.         if currentord < 0 then currentord := 0;
  135.         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  136.             currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  137.         else 
  138.             currenttop := 0;
  139.         AttachObjectList;
  140.     end;
  141. end;
  142.  
  143. { move a node to the bottom of the list }
  144. Procedure BottomGadFunc;
  145.  
  146. begin
  147.     if currentnode <> NIL then begin
  148.         DetachObjectList;
  149.         Remove(pNode(CurrentNode));
  150.         AddTail(CurrentList,pNode(CurrentNode));
  151.         tmpnode := pMyNode(currentlist^.lh_Head);
  152.         i := 0;
  153.         while tmpnode <> NIL do begin
  154.             tmpnode := pMyNode(tmpnode^.wi_Node.ln_Succ);
  155.             i := i + 1;
  156.         end;
  157.         CurrentOrd := i - 2;
  158.         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  159.             currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  160.         else 
  161.             currenttop := 0;
  162.         AttachObjectList;
  163.     end;
  164. end;
  165.  
  166. { add a new node to the list }
  167. Procedure NewGadFunc;
  168.  
  169. VAR
  170.     Changed : Boolean;
  171.  
  172. begin
  173.     DetachObjectList;
  174.     tmpnode := Add_Name('<< New Item >>');
  175.     changed := GadEDWindow(TheWindow^.LeftEdge+5, TheWindow^.TopEdge+Sizes[TBS], 
  176.         tmpnode);
  177.  
  178.     if changed then begin
  179.         CurrentNode := tmpnode;
  180.         CurrentOrd := 0;
  181.         if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  182.             currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  183.         else 
  184.             currenttop := 0;
  185.         DisableObjectGadgets(False_);
  186.     end else begin
  187.         Remove(pNode(tmpnode));
  188.     end;
  189.     AttachObjectList;
  190. end;
  191.  
  192. { remove a gadget node from the list }
  193. Procedure RemoveGadFunc;
  194.  
  195. begin
  196.     if currentnode <> NIL then begin
  197.         DetachObjectList;
  198.         DisableObjectGadgets(TRUE_);
  199.         Remove(pNode(CurrentNode));
  200.         CurrentNode := NIL;
  201.         CurrentOrd := -1;
  202.         AttachObjectList;
  203.     end;
  204. end;
  205.  
  206. { copy a gadget node }
  207. Procedure CopyGadFunc;
  208.  
  209. begin
  210.     if (CurrentNode <> NIL) then begin
  211.         DetachObjectList;
  212.         newnode := AllocRemember(@RememberKey, sizeof(tMyNode), MEMF_CLEAR);
  213.         newnode^ := CurrentNode^;
  214.         if newnode <> NIL then begin
  215.             Insert_(CurrentList,pNode(newnode),pNode(CurrentNode));
  216.             CurrentNode := newnode;
  217.             CurrentOrd := CurrentOrd + 1;
  218.             if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  219.                 currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  220.             else 
  221.                 currenttop := 0;
  222.         end;
  223.         AttachObjectList;
  224.     end;
  225. end;
  226.  
  227. { save the prefs file }
  228. Procedure SaveGadFunc;
  229. begin
  230.     wl := Pointer(rtLockWindow(TheWindow));
  231.     DetachObjectList;
  232.     IF NOT WriteConfigFile(V.arg_FileName) then DisplayBeep(NIL);
  233.     AttachObjectList;
  234.     AttachObjectList;
  235.     rtUnLockWindow(TheWindow, wl);
  236.     exitflag := True;
  237. end;
  238.  
  239. { save prefs file in user specified location }
  240. Procedure SaveAsGadFunc;
  241.  
  242. VAR 
  243. l, l2 : BPTR;
  244.  
  245. begin
  246.     wl := Pointer(rtLockWindow(TheWindow));
  247.     if AslRequest(sr, NIL) then begin
  248.         DetachObjectList;
  249.         l2 := Lock(STRPTR(sr^.fr_Drawer), ACCESS_READ);
  250.         l := currentdir(l2);
  251.         cfile := PtrToPas(STRPTR(sr^.fr_file));
  252.         IF NOT WriteConfigFile(cfile) then DisplayBeep(NIL);
  253.         l := currentdir(l); 
  254.         unlock(l2);
  255.         AttachObjectList;
  256.     end;
  257.     rtUnLockWindow(TheWindow, wl);
  258. end;
  259.  
  260. Procedure NewListFunc;
  261.  
  262. Begin
  263.     wl := Pointer(rtLockWindow(TheWindow));
  264.     DetachObjectList;
  265.     (* Start a' fresh *)
  266.     CurrentList := AllocRemember(@RememberKey, sizeof(tList), MEMF_CLEAR);
  267.     NewList(CurrentList);
  268.     InitCD;
  269.     CurrentNode := NIL;
  270.     CurrentOrd := -1;
  271.     currenttop := 0;
  272.     DisableObjectGadgets(TRUE_);
  273.     AttachObjectList; 
  274.     rtUnLockWindow(TheWindow, wl);
  275. end;
  276.  
  277. { load a new prefs file }
  278. Procedure LoadGadFunc;
  279.  
  280. VAR 
  281.     l, l2 : BPTR;
  282.  
  283. Begin
  284.     wl := Pointer(rtLockWindow(TheWindow));
  285.     if AslRequest(lr, NIL) then begin
  286.         DetachObjectList;
  287.                
  288.         l2 := Lock(STRPTR(lr^.fr_Drawer), ACCESS_READ);
  289.         l := currentdir(l2);
  290.                
  291.         cfile := PtrToPas(STRPTR(lr^.fr_file));
  292.  
  293.         If mode = LM_LOAD then 
  294.             CloseFont(CD.cd_TFont);
  295.         OKRes := ReadConfigFile(cfile, mode, RememberKey);
  296.         if OKRes then begin  
  297.             CurrentNode := NIL;
  298.             CurrentOrd := -1;
  299.             currenttop := 0;
  300.             DisableObjectGadgets(TRUE_);
  301.         end else DisplayBeep(NIL);
  302.  
  303.         AttachObjectList; 
  304.  
  305.         l := currentdir(l);
  306.         unlock(l2);
  307.     end; 
  308.     rtUnLockWindow(TheWindow, wl);
  309. end;
  310.                
  311. { if double click on LV then bring up the gadget edit window }
  312. Procedure LVGadFunc;
  313.  
  314. VAR 
  315.     y    : integer;
  316.     junk : Boolean;
  317.  
  318. Begin
  319.     oldord := currentord;
  320.     CurrentOrd := msgCode;
  321.     if currentord < 0 then currentord := 0;
  322.     if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
  323.         currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
  324.     else 
  325.         currenttop := 0;
  326.     CurrentNode := pMyNode(CurrentList^.lh_Head);
  327.     For y := 1 to currentord do
  328.         CurrentNode := pMyNode(CurrentNode^.wi_Node.ln_Succ);
  329.  
  330.     (* Double Click? *)
  331.     if (DoubleClick(CurrentSecs, CurrentMics, NewSecs, NewMics)) and
  332.     (currentord = oldord) then begin
  333.         wl := Pointer(rtLockWindow(TheWindow));
  334.         detachobjectlist;
  335.         junk := GadEDWindow(TheWindow^.LeftEdge+5, TheWindow^.TopEdge+Sizes[TBS], 
  336.         currentnode);
  337.         attachobjectlist;
  338.         rtUnLockWindow(TheWindow, wl);
  339.     end; 
  340.  
  341.     currentSecs := NewSecs;
  342.     CurrentMics := NewMics;
  343.  
  344.     DisableObjectGadgets(False_);
  345. end;
  346.  
  347.  
  348. { requester alowing user to pick a font }
  349. Procedure FontGadFunc;
  350.  
  351. VAR
  352.     tgs : Array[0..7] of tTagItem;
  353.     fr  : pFontRequester;
  354.  
  355. begin
  356.     tgs[0].ti_Tag  := ASLFO_TitleText;
  357.     tgs[0].ti_Data := LONG(CStrConstPtrAR(@RememberKey, 'Pick a font for the Pad'));
  358.     tgs[1].ti_Tag  := ASLFO_InitialName;
  359.     tgs[1].ti_Data := LONG(CD.cd_Font.ta_Name);
  360.     tgs[2].ti_Tag  := ASLFO_InitialSize;
  361.     tgs[2].ti_Data := long(CD.cd_Font.ta_YSize);
  362.     tgs[3].ti_Tag  := ASLFO_MaxHeight;
  363.     tgs[3].ti_Data := 100;
  364.     tgs[4].ti_Tag  := ASLFO_Flags;
  365.     tgs[4].ti_Data := 0;
  366.     tgs[5].ti_Tag  := ASLFO_Window;
  367.     tgs[5].ti_Data := long(TheWindow);
  368.     tgs[6].ti_Tag  := ASLFO_InitialStyle;
  369.     tgs[6].ti_Data := long(CD.cd_Font.ta_Style);
  370.     tgs[7].ti_Tag  := TAG_DONE;
  371.     fr := AllocASLRequest(ASL_FontRequest, @tgs);
  372.     if fr <> NIL then begin
  373.         wl := Pointer(rtLockWindow(TheWindow));
  374.         if AslRequest(fr, @tgs) then begin
  375.             CD.cd_Font := fr^.fo_Attr;
  376.             CD.cd_Font.ta_NAME := CStrConstPtrAR(@RememberKey, PtrToPas(fr^.fo_Attr.ta_Name)); 
  377.         end;
  378.         rtUnLockWindow(TheWindow, wl);
  379.         FreeAslRequest(fr);
  380.     end;
  381. end;
  382.  
  383.